home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / language / parallax / more_exa.tar / more / Skeleton / skeleton.p < prev   
Text File  |  1992-08-24  |  12KB  |  530 lines
  1. (**************************************************************************)
  2. (***                                    ***)
  3. (***        SKELETON.P                        ***)
  4. (***                                    ***)
  5. (***    Author :    Michael Reinhardt                ***)
  6. (***    Language :    Parallaxis V2                    ***)
  7. (***    Last Change :    May, 11, 1992                    ***)
  8. (***                                    ***)
  9. (***    Description :    This program thins a picture given in           ***)
  10. (***                    pbm-format                                      ***)
  11. (***                                    ***)
  12. (**************************************************************************)
  13.  
  14. SYSTEM  Thinning ;
  15.  
  16. CONST
  17.      MaxWidth    = 464 ;        (* maximal Width of input image *)
  18.      MaxHeight    = 98 ;        (* maximal Height of input image*)
  19.  
  20.      MaxStringLength    = 200 ;        (* maximal Stringlength        *)
  21.  
  22.     ByteLength    = 8 ;        (* number of bits per byte      *)
  23.     MaxByteValue    = 2**ByteLength;(* maximum value of a byte    *)
  24.  
  25.     (****************************************************************)
  26.     (* Magic Numbers for the Pictures in PBM-Plus Format         *)
  27.     (****************************************************************)
  28.     P1  = "P1";    (* Blackpicture            ASCII-Option    *)
  29.     P4  = "P4";    (* Blackpicture            RAWBIT-Option    *)
  30.     PBM = ".pbm";    (* Extension for pbm-Files            *)
  31.     (****************************************************************)
  32.  
  33. TYPE
  34.     STRING         = ARRAY [ 0 .. MaxStringLength ] OF CHAR;
  35.     BlackPicture = ARRAY [ 1 .. MaxHeight ] , [ 1 .. MaxWidth ] OF BOOLEAN;
  36.     BitField8     = ARRAY [ 1 .. ByteLength ] OF BOOLEAN;
  37.  
  38. CONFIGURATION
  39.     (********************************************************)
  40.     (* Twodimensional Grid                     *)
  41.     (********************************************************)
  42.      grid [ 1 .. MaxHeight ] , [ 1 .. MaxWidth ];
  43.  
  44. CONNECTION
  45. (********************************)
  46. (*    p1     p2    p3    *)
  47. (*        \   |    /        *)
  48. (*    p8  -    p    -    p4    *)
  49. (*        /    |    \        *)
  50. (*    p7    p6    p5    *)
  51. (********************************)
  52.      lo :     grid[ i , j ]     ->     grid[ i+1 , j-1 ].ru;
  53.      o  :     grid[ i , j ]     ->     grid[ i+1 , j   ].u;
  54.      ro :     grid[ i , j ]     ->     grid[ i+1 , j+1 ].lu;
  55.      r  :     grid[ i , j ]     ->     grid[ i      , j+1 ].l;
  56.      ru :     grid[ i , j ]     ->     grid[ i-1 , j+1 ].lo;
  57.      u  :     grid[ i , j ]     ->     grid[ i-1 , j   ].o;
  58.      lu :     grid[ i , j ]     ->     grid[ i-1 , j-1 ].ro;
  59.      l  :     grid[ i , j ]     ->     grid[ i   , j-1 ].r;
  60.  
  61. (************************* strcat *******************************************)
  62. (* catenation of two strings                                                *)
  63. (****************************************************************************)
  64.  
  65. PROCEDURE strcat( SCALAR first , second : STRING ) : SCALAR STRING ;
  66.  
  67. SCALAR
  68.     i , j : INTEGER ;
  69.  
  70. BEGIN
  71.     i := 0 ; j := 0 ;
  72.     WHILE ( ( first[i]  <> CHR(0) ) AND ( i < MaxStringLength ) ) DO
  73.         INC(i);
  74.     END ;
  75.  
  76.     WHILE ( ( second[j] <> CHR(0) ) AND ( i < MaxStringLength ) ) DO 
  77.         first[i]    := second[j] ;
  78.         INC(j) ;INC(i) ;
  79.     END ;
  80.  
  81.     first[i] := CHR(0) ;
  82.     RETURN first ;
  83.  
  84. END strcat ;
  85.  
  86. (****************** BitField2Char *******************************************)
  87. (* Conversion 8bit field into a char value                   *)
  88. (***************************************************************************)
  89.  
  90. PROCEDURE BitField2Char ( SCALAR BitField :BitField8 ) : SCALAR CHAR;
  91.  
  92. SCALAR
  93.     code    : INTEGER;
  94.     index    : INTEGER;
  95. BEGIN
  96.     code    := 0;
  97.  
  98.     FOR index := 0 TO ( ByteLength - 1 ) DO
  99.         IF BitField[ByteLength - index]
  100.         THEN
  101.             code    := code + 2**index;
  102.         END; (* IF *)
  103.     END; (* FOR *)
  104.  
  105.     RETURN CHR ( code);
  106. END BitField2Char;
  107.  
  108. (****************** Char2BitField *******************************************)
  109. (* Conversion char value into 8bit field                   *)
  110. (***************************************************************************)
  111.  
  112. PROCEDURE Char2BitField ( SCALAR ch :CHAR ) : SCALAR BitField8;
  113. SCALAR
  114.     code    : INTEGER;
  115.     index    : INTEGER;
  116.     BitField    : BitField8;
  117.     rest    : INTEGER;    
  118. BEGIN
  119.     code    := ORD ( ch );
  120.  
  121.     rest    := MaxByteValue;
  122.  
  123.     FOR index := (ByteLength - 1) TO 0 BY -1 DO
  124.  
  125.         rest    := rest DIV 2;
  126.  
  127.         IF code >= rest
  128.         THEN
  129.             BitField[ByteLength - index]    := TRUE;
  130.             code                := code - rest;
  131.         ELSE
  132.             BitField[ByteLength - index]    := FALSE;
  133.         END; (* IF *)
  134.     END; (* FOR *)
  135.  
  136.     RETURN BitField;
  137. END Char2BitField;
  138.  
  139. (************** WriteInteger ********************************************)
  140. (* Print Integer value with automatic length determination              *)
  141. (************************************************************************)
  142.  
  143. PROCEDURE WriteInteger (    SCALAR    Val    : INTEGER );
  144. SCALAR
  145.     Length    : INTEGER;
  146.  
  147. BEGIN
  148.     Length    := TRUNC (     Ln ( FLOAT ( ABS ( Val ) + 1 ) ) /
  149.                 Ln ( 10.0 ) ) + 1;
  150.  
  151.     IF Val < 0
  152.     THEN
  153.         Length    := Length + 2;
  154.     END; (* IF *)
  155.  
  156.     WriteInt ( Val , Length );
  157.  
  158. END WriteInteger;
  159.  
  160. (************** ReadHeader *****************************************)
  161. (* Reads Header of PPM or PBM file                   *)
  162. (* Returns Height, Width, DeltaX and DeltaY of image           *)
  163. (*******************************************************************)
  164.  
  165. PROCEDURE ReadHeader (SCALAR     InputFile            : STRING;
  166.                   SCALAR VAR PicWidth, PicHeight, MaxColors    : INTEGER)
  167.                              : SCALAR BOOLEAN;
  168. SCALAR
  169.     magic, comment    : STRING;
  170.     ch        : CHAR;
  171.     kommentar    : BOOLEAN;
  172.     Ergebnis    : BOOLEAN;
  173. BEGIN
  174.     OpenInput( InputFile ) ;     (* open File *)
  175.  
  176.     Ergebnis    := TRUE;
  177.     PicWidth    := 0;
  178.     PicHeight    := 0;
  179.     MaxColors    := 0;
  180.  
  181.     IF Done THEN
  182.  
  183.         ReadString( magic ) ;
  184.         ReadString ( comment );
  185.  
  186.         IF ( comment[0] = "#" )
  187.         THEN
  188.             kommentar    := TRUE;
  189.         ELSE
  190.             kommentar    := FALSE;
  191.         END; (* IF *)
  192.  
  193.         IF NOT kommentar
  194.         THEN
  195.             CloseInput;
  196.             OpenInput ( InputFile );
  197.             ReadString ( magic );
  198.         ELSE
  199.             ch        := CHR ( 0 );
  200.             WHILE ch <> EOL DO
  201.                 Read ( ch );
  202.             END; (* IF *)
  203.         END; (* IF *)
  204.  
  205.         ReadInt( PicWidth ) ; (* reading Height and Width of image *)
  206.         ReadInt( PicHeight ) ;
  207.  
  208.         WriteString ( " black & white image          " );
  209.  
  210.         IF    STREQ ( P4 , magic ) 
  211.         THEN
  212.             WriteString ( "compressed" );
  213.             Read ( ch );
  214.         ELSE
  215.             WriteString ( "not compressed" );
  216.         END; (* IF *)
  217.  
  218.         WriteLn;
  219.  
  220.         WriteString ( " File  : " );
  221.         WriteString ( InputFile );
  222.         WriteString ( " Magic : " );
  223.         WriteString ( magic );
  224.         WriteLn;
  225.         WriteString ( " Width  : " );
  226.         WriteInteger ( PicWidth  );
  227.         WriteString ( " Height : " );
  228.         WriteInteger ( PicHeight );
  229.         WriteString ( " Colors : ");
  230.         WriteInteger ( MaxColors );
  231.         WriteLn;
  232.         WriteLn;
  233.  
  234.     ELSE
  235.  
  236.         WriteLn;
  237.         WriteString ( " ERROR !!! " );
  238.         WriteLn;
  239.         WriteString ( " File : " );
  240.         WriteString ( InputFile );
  241.         WriteString ( " couldn't get opened !!! " );
  242.         WriteLn;
  243.  
  244.         Ergebnis := FALSE;
  245.  
  246.     END; (* IF *)
  247.  
  248.     IF (PicHeight > MaxHeight) OR (PicWidth > MaxWidth)
  249.     THEN
  250.         WriteLn;
  251.         WriteString ( " ERROR !!! " );
  252.         WriteLn;
  253.         WriteString ( " File : " );
  254.         WriteString ( InputFile );
  255.         WriteLn;
  256.         WriteString ( "The image is too large for being processsed !!!" );
  257.         WriteLn;
  258.         WriteString ( "Maximum width  : " );
  259.         WriteInteger ( MaxWidth );
  260.         WriteLn;
  261.         WriteString ( "Maximum height : " );
  262.         WriteInteger ( MaxHeight );
  263.  
  264.         Ergebnis := FALSE;
  265.     END; (* IF *)
  266.  
  267.     Ergebnis := Ergebnis AND Done;
  268.  
  269.     RETURN Ergebnis;
  270.  
  271. END ReadHeader;
  272.  
  273.  
  274. (************************** ReadComPBM ***************************)
  275. (* Reads a compressed PBM file                         *)
  276. (************************************************************************)
  277. PROCEDURE ReadComPBM (
  278.      SCALAR         InputFile         : STRING;
  279.     SCALAR VAR    Image            : BlackPicture;
  280.     SCALAR VAR    PicWidth, PicHeight    : INTEGER )
  281.                         : SCALAR BOOLEAN ;
  282. SCALAR
  283.     XPos, YPos, index, X    : INTEGER;
  284.     FileName        : STRING;
  285.     Ch            : CHAR;
  286.     BitField            : BitField8;
  287.     MaxColor        : INTEGER;
  288.     Result            : BOOLEAN;
  289. BEGIN
  290.     FileName := strcat ( InputFile , PBM );
  291.  
  292.     Result := ReadHeader ( FileName , PicWidth, PicHeight , MaxColor );
  293.  
  294.     WriteString ("Reading input ..."); WriteLn;
  295.  
  296.     IF Result THEN
  297.  
  298.         FOR YPos := 1 TO PicHeight DO
  299.  
  300.             XPos    := 0;
  301.  
  302.             FOR X := 0 TO ( PicWidth - 1 ) DIV ByteLength DO
  303.  
  304.                 Read ( Ch );
  305.                 BitField     := Char2BitField ( Ch );
  306.  
  307.                 FOR index := 1 TO ByteLength DO
  308.  
  309.                     INC ( XPos );
  310.  
  311.                     IF XPos    <= PicWidth
  312.                     THEN
  313.                         Image[YPos][XPos]
  314.                             := BitField[index];
  315.                     END; (* IF *)
  316.  
  317.                 END; (* FOR index *)
  318.  
  319.             END; (* FOR X *)
  320.  
  321.         END; (* FOR YPos *)
  322.  
  323.     END; (* IF *)
  324.  
  325.     CloseInput;
  326.  
  327.         WriteString ("Input read."); WriteLn;
  328.     RETURN Result;
  329.  
  330. END ReadComPBM ;
  331.  
  332.  
  333. (************************* WriteComPBM ***************************)
  334. (* Writes compressed PBM file                         *)
  335. (************************************************************************)
  336. PROCEDURE WriteComPBM (
  337.         SCALAR    OutputFile             : STRING;
  338.         SCALAR    Image                : BlackPicture;
  339.         SCALAR    PicWidth, PicHeight        : INTEGER )
  340.                             : SCALAR BOOLEAN;
  341. SCALAR
  342.     XPos, YPos, index, X    : INTEGER;
  343.     FileName        : STRING;
  344.     Ch            : CHAR;
  345.     BitField            : BitField8;
  346. BEGIN
  347.     FileName    := strcat ( OutputFile , PBM );
  348.  
  349.     WriteString ("Writing output ..."); WriteLn;
  350.  
  351.     OpenOutput( FileName ) ;
  352.  
  353.     WriteString ( P4 ) ;        (* RAWBIT option, not ASCII *)
  354.     WriteLn;
  355.  
  356.     WriteString ( "# " );
  357.     WriteString ( FileName );
  358.     WriteLn;
  359.  
  360.     WriteInteger ( PicWidth );    (* without vertical margins    *)
  361.     Write (" ");
  362.     WriteInteger ( PicHeight );    (* without horizontal margins    *)
  363.     WriteLn;
  364.  
  365.     FOR YPos := 1 TO PicHeight DO
  366.  
  367.         XPos    := 0;
  368.  
  369.         FOR X := 0 TO ( PicWidth - 1 ) DIV ByteLength DO
  370.  
  371.             FOR index := 1 TO ByteLength DO
  372.  
  373.                 INC ( XPos );
  374.  
  375.                 IF XPos    <= PicWidth
  376.                 THEN
  377.                     BitField[index]    := Image[YPos][XPos];
  378.                 ELSE
  379.                     BitField[index]    := TRUE;
  380.                 END; (* IF *)
  381.  
  382.             END; (* FOR index *)
  383.  
  384.             Ch    := BitField2Char ( BitField );
  385.  
  386.             Write ( Ch );
  387.  
  388.         END; (* FOR X *)
  389.  
  390.     END; (* FOR YPos *)
  391.  
  392.     CloseOutput ;
  393.  
  394.     WriteString ("Output written."); WriteLn;
  395.  
  396.     RETURN TRUE;
  397.  
  398. END WriteComPBM ;
  399.  
  400.  
  401. (******* ThinningZA2 ***************************************)
  402. (* Thinning Algorithm with 2 subiterations            *)
  403. (****************************************************************)
  404. PROCEDURE ThinningZA2 (    SCALAR        InImage        : BlackPicture;
  405.             SCALAR VAR    OutImage    : BlackPicture;
  406.             SCALAR        Width, Height    : INTEGER );
  407. SCALAR
  408.     ende            : BOOLEAN;
  409.     Direction        : INTEGER;
  410. VECTOR
  411.     hasChanged,
  412.     p1, p2, p3,
  413.     p8, p,  p4,
  414.     p7, p6, p5        : BOOLEAN;
  415.     criteria        : BOOLEAN;
  416. BEGIN
  417.     LOAD grid ( p , InImage );
  418.  
  419.     ende        := FALSE;
  420.  
  421.     (********************************)
  422.     (* Directions             *)
  423.     (*     0 =     Upper left    *)
  424.     (*    1 =    Lower right    *)
  425.     (********************************)
  426.     Direction    := 0;
  427.  
  428.     PARALLEL grid [1..Height],[1..Width]
  429.  
  430.             WHILE NOT ende DO
  431.  
  432.  
  433.             IF Direction = 0
  434.             THEN
  435.                 hasChanged    := FALSE;
  436.             END; (* IF *)
  437.  
  438.             PROPAGATE.l     ( p , p4 );
  439.             PROPAGATE.lo    ( p , p5 ); 
  440.             PROPAGATE.o     ( p , p6 );
  441.             PROPAGATE.ro    ( p , p7 );
  442.             PROPAGATE.r     ( p , p8 );
  443.             PROPAGATE.ru    ( p , p1 );
  444.             PROPAGATE.u     ( p , p2 );
  445.             PROPAGATE.lu    ( p , p3 );
  446.  
  447.             CASE Direction OF
  448.             (* From Upper right    *)
  449.             0 :
  450.               criteria :=    ( NOT p1 AND NOT p2 AND NOT p3 AND
  451.                     p5 AND p6 )
  452.                     OR ( NOT p2 AND NOT p3 AND NOT p4 AND
  453.                     p6 AND p8 );
  454.  
  455.               criteria :=    criteria OR
  456.                     ( NOT p3 AND NOT p4 AND NOT p5 AND
  457.                     p7 AND p8 )
  458.                     OR ( NOT p4 AND NOT p5 AND NOT p6 AND
  459.                     p8 AND p2 );
  460.  
  461.             (* From lower left    *)
  462.             | 1 :
  463.               criteria :=    ( NOT p5 AND NOT p6 AND NOT p7 AND
  464.                     p1 AND p2 )
  465.                     OR ( NOT p6 AND NOT p7 AND NOT p8 AND
  466.                     p2 AND p4 );
  467.  
  468.                criteria :=    criteria OR
  469.                     ( NOT p7 AND NOT p8 AND NOT p1 AND
  470.                     p3 AND p4 )
  471.                     OR ( NOT p8 AND NOT p1 AND NOT p2 AND
  472.                             p4 AND p6 );
  473.  
  474.             END; (* CASE *)
  475.  
  476.             (************************************************)
  477.             (* Test, if pixel can be eliminated         *)
  478.             (************************************************)
  479.             IF p AND criteria
  480.             THEN
  481.                 p        := FALSE;
  482.                 hasChanged    := TRUE;
  483.             END;
  484.  
  485.             IF Direction = 0
  486.             THEN
  487.                 ende    := NOT (REDUCE.OR ( hasChanged ));
  488.             ELSE
  489.                 ende    := FALSE;
  490.             END; (* IF *)
  491.  
  492.         Direction    := ( Direction + 1 ) MOD 2;
  493.  
  494.         END; (* WHILE *)
  495.  
  496.     ENDPARALLEL;
  497.  
  498.     STORE grid ( p , OutImage );
  499.  
  500. END ThinningZA2;
  501.  
  502.  
  503. SCALAR    InFile, OutFile    : STRING;
  504.     Image        : BlackPicture;
  505.     Skeleton    : BlackPicture;
  506.     Width, Height    : INTEGER;
  507.     isLoaded, isWritten    : BOOLEAN;
  508.  
  509.  
  510. BEGIN (* Main *)
  511.     WriteString ( "Input PBM file (withput extension .pbm) ? ");
  512.     ReadString ( InFile );
  513.     WriteLn;
  514.  
  515.     WriteString ( "Thinned output PBM file ? ");
  516.     ReadString ( OutFile );
  517.  
  518.     (* Load image *)
  519.     isLoaded := ReadComPBM ( InFile , Image , 
  520.                 Width , Height );
  521.     IF isLoaded THEN
  522.             WriteString ("Thinning ..."); WriteLn;
  523.         ThinningZA2 ( Image , Skeleton, Width, Height );
  524.             WriteString ("Thinning done."); WriteLn;
  525.         isWritten := WriteComPBM (OutFile, Skeleton, Width, Height);
  526.     END; (* IF *)
  527.  
  528. END Thinning.
  529.  
  530.